Option Public
Option Explicit
'『修改历史』



Function replacestring(strSource As String,strFrom As String,strTo As String) As String
'『函数功能』
'	子字符串替换
'『函数接口』
'	strSource		input	将要被处理的字符串
'	strFrom		input	查找的目标子字符串
'	strTo		input	查找对象将被替换成这个子字符串
'『函数返回值』
'	类型：字符串	替换以后的字符串
'『作者』
	
'『说明』	
'	可以用evaluate("@ReplaceSubString(...)")的方式实现相同功能，但是不稳定
'『修改历史』
	
'   	 	修改了最后一个匹配项后面的字符串丢失的bug
	
	Dim strTmp As String
	Dim nBegin,nIndex As Long
	strTmp = ""
	
	nBegin = 1
	nIndex = Instr(strSource,strFrom)
	If(nIndex>0) Then
		While(nIndex>0)
			strTmp = strTmp + Mid$(strSource,nBegin,nIndex-nBegin) + strTo
			nBegin = nIndex + Len(strFrom)
			nIndex = Instr(nBegin,strSource,strFrom)
		Wend
		strTmp = strTmp + Mid$(strSource,nBegin)	
	Else	'如果找不到目标字符串，则返回原字符串
		strTmp = strSource
	End If
	replacestring = strTmp
End Function
Function appendAryToList(astrDes As Variant, astrSrc As Variant) As Variant
'把数组追加到另一个数组后面
	
	On Error Goto errhandle
	Dim astr As Variant
	Dim strName As notesname
	Dim i As Integer
	Dim j As Integer
	Dim intFlag As Integer
	
	'Msgbox astrSrc(i)
	
	astr=astrDes
	For i=0 To Ubound(astrSrc)
		Set strName=New notesname(astrSrc(i))
		intFlag=0
		For j=0 To Ubound(astr)
			If strName.canonical=astr(j) Or strName.abbreviated=astr(j) Or strName.common=astr(j) Then
				intFlag=1
				j=Ubound(astr)+1
			End If
		Next j
		If intFlag=0 Then
			If Ubound(astr)=0 And Trim(astr(0))="" Then
				astr(0)=strName.canonical
			Else
				Redim Preserve astr(Ubound(astr)+1)
				astr(Ubound(astr))=strName.canonical
			End If
		End If
	Next i
	
	appendAryToList=astr
	Exit Function
errhandle:
	Msgbox "appendAryToList:" + Cstr(Error()) + " at line "+Cstr(Erl())
	appendAryToList=astr
End Function
Function GetDocumentByDocID(db As NotesDatabase, strDocID As String) As NotesDocument
%REM
根据静态ID(DocID)获得文档
%END REM
	On Error Goto errorHandle
	Set GetDocumentByDocID = Nothing
	
	'变量定义
	Dim s As New NotesSession
	Dim dbCurrent As NotesDatabase
	Dim vmMap As NotesView
	Dim doc As NotesDocument
	
	'常量定义
	Const NAMEOFMAP = "MapUNID.vw"
	
	Set dbCurrent = s.CurrentDatabase
	
	If db Is Nothing Then
		Set db = dbCurrent
	End If
	
	Set vmMap = db.GetView(NAMEOFMAP)
	
	If Not vmMap Is Nothing Then
		Set doc = vmMap.GetDocumentByKey(strDocID,True)	
		If doc Is Nothing Then
			Msgbox "数据库[" + db.Title + "]视图[" + NAMEOFMAP + "]中不存在文档[" + strDocID + "]"
			Exit Function
		Else
			Set GetDocumentByDocID = doc
		End If
	Else
		Msgbox "数据库[" + db.Title + "]中不存在视图[" + NAMEOFMAP + "]"
	End If
	
	Exit Function
errorHandle:
	ShowError "GetDocumentByDocID"
	Set GetDocumentByDocID = Nothing
	Exit Function
End Function
Function removeCurUserFromList(nmUser As notesname ,astrUserList As Variant) As Variant
' 『函数功能』
'	将用户从用户列表数组中移除
'	1、考虑三种不同格式的用户姓名都需要移除（增强容错性）
'	
' 『函数接口』
'	nmUser			input	需要移除的用户姓名对象
'	astrUserList		input	用户列表数组
'	strError			outpt	未通过有效性检查时，返回的错误信息
'	
' 『函数返回值』
'	类型：variant
'		数组		移除了指定用户的用户列表数组，若无用户则第0元素为"None"
'	
' 『备注』
'
' 『作者』
	
' 『修订历史』
	
'	错误捕获	
	On Error Goto errhandler	
	
	'把指定处理人从用户列表数组中去除(Canonical格式)
	removeCurUserFromList = RebuildList(astrUserList,nmUser.Canonical)
	'把指定处理人从用户列表数组中去除(abbreviated格式)
	removeCurUserFromList = RebuildList(removeCurUserFromList,nmUser.Abbreviated)
	'把指定处理人从用户列表数组中去除(common格式)
	removeCurUserFromList = RebuildList(removeCurUserFromList,nmUser.Common)
	
	Exit Function
errhandler:
	Msgbox "removeCurUserFromList error " & Error & " in line " & Cstr(Erl)
	ShowError("removeCurUserFromList")
End Function
Function fnItemCopy(docMain  As notesdocument,strSourceItemName As String ,strObjectItemName As String,intObjectItemType As Integer)  As Integer
%REM	

' 『函数功能』
'	把文档中域拷贝特殊类型的域
	
' 『函数接口』
	docMain                      当前文档            
	strSourceItemName    原Item名字 ,
	strObjectItemName    拷贝Item名字,
     intObjectItemType 　 Item 类型　
0........不做修改
1........姓名域
2.........作者域
3........读者域
	
' 『函数返回值』
'	true ,操作成功
　false  ,操作失败
' 『备注』
'
' 『作者』

' 『修订历史』
%END REM
	On Error Goto errhandler	
	
	Dim itemSource As notesitem
	Dim ItemObject As notesitem
	Dim intItemType As Integer
	
	fnItemCopy=False
	
	If Len(strObjectItemName)>32 Then
		strObjectItemName=Left(strObjectItemName,32)
	End If
	Set itemSource=docMain.getfirstitem(strSourceItemName)
	If itemSource Is Nothing Then
		Exit Function
	End If
	
	
	' if the object item exist , remove it 
	If docMain.hasitem(strObjectItemName) Then
		
		Call docMain.removeitem(strObjectItemName)
	End If
	'Set the Item Type
	
	Select Case intObjectItemType
	Case 0:
		Set	ItemObject =docMain.copyitem(itemSource,strObjectItemName)
		fnItemCopy=True
		Exit Function
	Case 1:
		intItemType=NAMES
	Case 2:
		intItemType=Authors
	Case 3:
		intItemType=READERS 
	End Select
	If ItemSource.type<>1 Then '　the Item is not a richtext item
		Set ItemObject= New NotesItem( docMain, strObjectItemName, itemSource.values ,  intItemType)
	Else
	End If	
	fnItemCopy=True
	Exit Function
errhandler:
	showError("fngetRemindMethod")
End Function
Function unique(astrArray)
'『函数功能』
'	处理给定数组，使该数组中没有重复的元素
'『函数接口』
'	srcArray		input	处理目标数组
'『函数返回值』
'	处理后的数组
	
	Dim strResult As String
	Dim strMacro As String
	Dim i As Integer
	
	strResult = |"| + astrArray(0) + |"|
	For i=1 To Ubound(astrArray)
		strResult = strResult + |:"| + astrArray(i) + |"|
	Next
	strMacro = |@unique(| + strResult + |)|
	unique = Evaluate(strMacro)
	
End Function
%REM
	Function getDocumentByViewKey
	Description: Comments for Function
%END REM
Function getDocumentByViewKey(strServerName As String _
	, strDBPath As String, strViewName As String _
	, strKey As String, blExactMatch As Boolean)As NotesDocument
try:
	'set up error handler
	On Error GoTo catch
	Set getDocumentByViewKey = Nothing
	
	Dim session As New NotesSession
	Dim db As NotesDatabase
	Dim dbCurrent As NotesDatabase
	Dim view As NotesView
	Dim doc As NotesDocument	
	
	'获得当前数据库
	Set dbCurrent = session.Currentdatabase
	
	'如果服务器名未传入
	If strServerName = "" Then
		
		'获得当前数据库所在服务器
		strServerName = dbCurrent.Server
	End If
	
	'获得数据库
	If strDBPath = "" Then
		Set db = dbCurrent
	Else
		Set db = session.Getdatabase(strServerName, strDBPath, False)
	End If
	
	
	If db.Isopen Then
		Set view = db.Getview(strViewName)
		If Not view Is Nothing Then
			If strKey = "" Then
				Set doc = view.Getfirstdocument()
			Else
				Set doc = view.Getdocumentbykey(strKey, blExactMatch)
			End If
			
		End If
	End If	
	
	Set getDocumentByViewKey = doc
	
		GoTo finally
catch:
	'log error
	'Msgbox Erl & ":" & Error
	MsgBox LSI_Info(2) & " called by " & LSI_Info(12) & "(" & LSI_Info(430) & "): " & Error$ & " - Line: " & CStr(Erl)
	'resume to the final thing
	Resume finally
	
finally:
	'do the final thing
	
End Function
Function getRefValue(Byval strURLParam As String,strTitle As String)As String
'『函数功能』
'	Domino的应用可利用URL来传递参数，本函数从URL中读取指定参数项的值
'『函数接口』
'	strURLParam	input	URL部分字符串，例如： ?openform&count=20&start=41
'	strTitle		input	指定要读取的参数项，例如：count=
'『函数返回值』
'	指定参数项的值	字符串	例如：20，如果找不到指定的参数项，则返回空字符串
	
	Dim strTemp As String
	Dim intPos1 As Integer,intPos2 As Integer
	
	On Error Goto errorHandle
	
	strTemp=strURLParam
	intPos1=Instr(strTemp,"&"+strTitle)+1
	If intPos1=1 Then
		getRefValue=""
		Exit Function
	End If
	strTemp=Right(strTemp,Len(strTemp)-intPos1-Len(strTitle)+1)
	intPos2=Instr(strTemp,"&")
	If(intPos2>0)Then
		strTemp=Left(strTemp,intPos2-1)
	End If
	getRefValue=strTemp
	
	Exit Function
	
errorHandle:
	Call ShowError("getRefValue")
	
End Function
Sub printMessageOk(strMsg As String,strRetLink As String)
' 『函数功能』		显示通知信息页面（通知用户进行了某种操作，例如发邮件）
' 『函数接口』
'	ResourcePath	input	资源路径
'	strMsg		input	显示的信息
'	strRetLink	input	返回链接
' 『函数返回值』	无
' 『备注』		无
' 『作者』		
' 『修订历史』		
	Dim ResourcePath As String
	ResourcePath = "/StdPublic/oaresource.nsf/"
	Print |<body backGround="| + ResourcePath + |images/yubj.gif" topmargin="0" rightmargin="0" bottommargin="0" leftmargin="0" onunload="if(window.opener&&window.opener.refreshI){window.opener.refreshI()}">|
	Print |<table width=102% border=0 cellSpacing=0 cellPadding=0  backGround="| + ResourcePath + |images/yubj.gif">|
	Print |  <tr>|
	Print |    <td></td>|
	Print |    <td>|
	Print |      <table cellSpacing=0 cellPadding=0 border=0 align=right>|
	Print |        <tr height="15"><td></td></tr> |
	Print |        <tr height="29">|
	Print |          <td>&nbsp;&nbsp;&nbsp;&nbsp;</td>|
	Print |        </tr>|
	Print |      </table>|
	Print |    </td>|
	Print |  </tr>|
	Print |  <tr>|
	Print |    <td background="| + ResourcePath + |images/yubj.gif" height ="19" align="right" valign="bottom" colspan="2">|
	Print |	      &nbsp;|
	Print |    </td>|
	Print |  </tr>|
	Print |</table>|
	Print |<br><br>|
	Print |<fieldset style="width:500; height:200;border-color:##F1F1F1;border-width:8px" align=center>|
	Print |<legend width=25%><font color="#ff5454" style="font-weight:bold">&nbsp;操作提示&nbsp;</font></legend>|
	Print |<table width=100% height=100% valign=middle cellpadding=10 backGround="| + ResourcePath + |images/yubj.gif">|
	Print |	<tr>|
	Print |		<td align=center>| + strMsg + |</td>|
	Print |	</tr>|
	Print |	<tr>|
	Print |		<td align=center><font size="2" color="blue">| + strRetLink + |</font></td>|
	Print |	</tr>|
	Print |</table>|
	Print |</fieldset>|
	Print |</body>|
	
	
End Sub
Sub WriteToRtfWithHtmlStyle(doc As notesdocument, Byval strRtfFieldName As String, _
Byval strText As String)
'『函数功能』
'	向RTF域写入HTML文本，并在Web端以HTML方式显示
' 	为了克服 Notes对于字符串变量长度不能超过64K的限制，使用本函数
'『函数接口』
'	doc				input	写入内容的目标文档
'	strRtfFieldName	input	写入文档的目标RTF域对象
'	strText			output	准备写入的字符串（注意，有64K限制）
'『作者』
	
'『修订历史』
	
'		1、取消 HTML style 的设置
'		2、简化函数接口，取消session
'『说明』	
'	本函数最初有两个目的：一是为了解决Notes字符串的64K限制，因此将内容拆成多个字符串，分别
'写到目标RTF域的多个段落中；二是为了解决页面出现HTML代码的问题，这个改成在表单中，将目标域的
'样式设置为HTML来实现，因此函数中有关代码被略去。
	
	On Error Goto errorHandle
	
	' 需要在表单中将rtf域的样式设置为html，所以此处代码略去
	
	Dim rtitem As Variant
	If doc.hasitem(strRtfFieldName) Then
		Set rtitem = doc.GetFirstItem(strRtfFieldName)
		If rtitem.Type <> RICHTEXT Then
			Call rtitem.remove
			Set rtitem = New NotesRichTextItem(doc,strRtfFieldName)
		End If
	Else 
		Set rtitem = New NotesRichTextItem(doc,strRtfFieldName)
	End If
	
	rtitem.appendText(strText)
	
	Exit Sub
	
errorHandle:
	Msgbox "writetortfwithhtml error:"+Error$+ Cstr(Erl)
	Call ShowError("WriteToRtfWithHtmlStyle")
	
End Sub
Function appendList(srcArray As Variant,keyStr As String) As Variant
	
	On Error Goto errorhandle	
	Dim stringArray As Variant
	stringArray=srcArray
	If Ubound(stringArray)=0 And Trim(stringArray(0))="" Then
		stringArray(0)=keyStr
	Elseif getIndex(stringArray,keyStr)=-1 Then
		Redim Preserve stringArray(Ubound(stringArray)+1)
		stringArray(Ubound(stringArray))=keyStr
	End If
	appendList=stringArray
	
	Exit Function
errorhandle:
	Print "error in appendList in wFlowLib:"+Error$()+" in line:"+Cstr(Erl()) 
End Function
Function getPath(db As notesdatabase) As String
'『函数功能』
'	获取数据库所在的目录
'		
'『函数接口』
'	db	input	数据库对象
'『作者』	
	
	
	Dim intPos As Long
	Dim strDbPath As String
	strDbPath=replacestring(db.filepath,"\","/")
	strDbPath=Trim(Strleftback(strDbPath,"/",1,1))
	If strDbPath<>"" Then getPath=strDbPath+"/"
End Function
Function getDocumentByUnid(m_database As notesdatabase,strUnid As String) As NotesDocument
%REM
	功能：
	根据给定的文档标识，从数据库中返回该文档。如果该标识非法、或者没有该文档，则返回nothing
	返回值：
	指定文档
%END REM
'由于db.getdocumentbyunid一旦找不到直接就会出错，因此利用此函数屏蔽错误，使程序能够继续进行
	
	Dim docResult As notesdocument
	
	Set docResult=Nothing
	
	On Error Resume Next
	
	Set docResult = m_database.GetDocumentByUNID(strUnid)		
	Set getDocumentByUnid = docResult				
	
End Function
Function appendNameToList(srcArray As Variant,curName As String) As Variant
'把当前服务器名添加到列表中
	
	On Error Goto errorhandle	
	Dim stringArray As Variant
	stringArray=srcArray
	If Ubound(stringArray)=0 And Trim(stringArray(0))="" Then
		stringArray(0)=Trim(curName)
	Else
		Redim Preserve stringArray(Ubound(stringArray)+1)
		stringArray(Ubound(stringArray))=Trim(curName)
	End If
	appendNameToList=stringArray
	Exit Function
errorhandle:
	Msgbox "appendNameToList :" + Cstr(Error())+ " at line " + Cstr(Erl())
	appendNameToList=stringArray
End Function
Sub writeToReadersField(docCurrent As notesdocument,strFieldName As String,value As Variant)
' 『函数功能』
'	1、将value值写入读者域中
'	2、确保该域设置了作者域属性（即使是后台产生的文档）
'
'	
' 『函数接口』
'	docCurrent		input	当前文档
'	strFieldName		input	需要写入的域的域名
'	value			input	域值
'	
' 『函数返回值』
'	无
'		
'	
' 『备注』
'	如果是后台产生的文档，其中的域纵然是在表单中设置了读者域
'	该域也可能不是读者域，因此必须使用本函数
'	
' 『作者』
	
' 『修订历史』
	
	
	'write the value to a reades field, and confirm the field is set to readers field,
	'even if the field is created by background
	Call docCurrent.replaceitemvalue(strFieldName,value)
	Dim item As notesitem
	Set item=docCurrent.getfirstitem(strFieldName)
	If Not item Is Nothing Then
		'if the item is created by background, it will be a text field, not a 
		'readers field, so we will force it to be a readers field.
		If Not item.IsReaders Then
			item.IsReaders=True
		End If
	End If
End Sub
Function isSamePerson(strFirst As String,strSecond As String) As Variant
' 『函数功能』
'	检查两个用户名代表的用户是否相同（考虑common、abbreviate、canonical等格式都可能）
'
'	
' 『函数接口』
'	strFirst			input	第一个用户名
'	strSecond			input	第二个用户名
'	
' 『函数返回值』
'	类型：	variant
'				true		两个用户名代表同一个用户
'				false	两个用户名代表不同的用户
'	
' 『备注』
'	目前只要三种形式之一的一种对上即可（主要是common）
'	如果将来需要严格用户识别，则需要再修改本函数
' 『作者』
	
' 『修订历史』
	
	
'	定义临时变量
	Dim nmFirst As New notesname(Ucase(strFirst))			'第一个用户名
	Dim nmSecond As New notesname(Ucase(strSecond))			'第二个用户名
	
	If nmFirst.common=nmSecond.common Then
		isSamePerson = True
	Else
		isSamePerson = False
	End If
End Function
Function ShowError(strFunction As String)As String
'『函数功能』
'	根据简要表判断是否需要显示出错信息，如果需要，则显示之
'	（根据运行方式不同显示在Domino Console或者客户端）
'『函数接口』
'	strFunction	input	出错的函数名称
'『作者』	
	
'『修订历史』
	
'		1、修改函数接口，去掉session，代之以在函数中new一个，提供函数通用性
'		2、增加是否需要显示出错信息的判断
'		3、在本函数中增加 On Error Resume Next 设置
	
'		不再使用notes.ini来存放调试状态，因为需要"无限制代理"的权限，太高
	
	On Error Resume Next
	
	Dim session As New NotesSession
	Dim dbCurrent As NotesDatabase
	Dim agent As NotesAgent
	Dim blnIsShowError As Variant			' 调试标记：为true时显示出错信息
	Dim strErrorMsg As String
	
	Set dbCurrent = session.currentdatabase	'当前数据库
	
	blnIsShowError = True				' 如果尚为设置，则不显示错误信息
	
	Set agent = session.Currentagent		'当前代理
	strErrorMsg = "在数据库" & dbCurrent.filepath & "中的" & agent.name &_
	"代理的" & strFunction & "函数的第" & Cstr(Erl) & "行中，出现错误" &_
	Cstr(Err) & "：" & Error$
	If blnIsShowError Then	
		Msgbox strErrorMsg
		ShowError = strErrorMsg
	End If
	
End Function
Sub printErrorMessage(strMsg As String,strJS As String)
%REM
当出现错误信息时提示并处理
%END REM
	Print |<script language=javascript><!--|
	Print |alert("| + strMsg + |");|
	Print strJS
	Print |//-->|
	Print |</script>|
	
End Sub
Sub writeToAuthorsField(docCurrent As notesdocument,strFieldName As String,value As Variant)
' 『函数功能』
'	1、将value值写入作者域中
'	2、确保该域设置了作者域属性（即使是后台产生的文档）
'
'	
' 『函数接口』
'	docCurrent		input	当前文档
'	strFieldName		input	需要写入的域的域名
'	value			input	域值
'	
' 『函数返回值』
'	无
'		
'	
' 『备注』
'	如果是后台产生的文档，其中的域纵然是在表单中设置了作者域
'	该域也可能不是作者域，因此必须使用本函数
'	
' 『作者』
	
' 『修订历史』
	
	
	Call docCurrent.replaceitemvalue(strFieldName,value)
	Dim item As notesitem
	Set item=docCurrent.getfirstitem(strFieldName)
	If Not item Is Nothing Then
		'if the item is created by background, it will be a text field, not a 
		'authors field, so we will force it to be a authors field.
		If Not item.IsAuthors Then
			item.IsAuthors=True
		End If
	End If
End Sub
Function isNameInAry(curName As String , AryIn As Variant)As Integer
'判断名称是否已经存在于列表中
	
	On Error Goto ErrorHandle
	
	Dim ListMax As Integer
	Dim i As Integer
	Dim intReturn As Integer
	i = 0
	intReturn = False
	ListMax = Ubound(AryIn)
	While ListMax>=i And intReturn=False
		If Trim(AryIn(i)) = Trim(curName) Then
			intReturn = True 			
		End If
		i = i + 1
	Wend
	isNameInAry = intReturn
	
	Exit Function
ErrorHandle:
	Msgbox "isNameInAry :" + Cstr(Error())+ " at line " + Cstr(Erl())
	isNameInAry=True
End Function
Sub showWebError(strErrorMsg As String)
'『函数功能』
'	在Web端显示错误信息。使用JavaScript弹出对话框显示错误信息。
'『函数接口』
'		strErrorMsg 	input	错误信息
'『作者』
	
	
	Print |<Script Language="JavaScript">
	alert('| & strErrorMsg & |');
	history.go(-1);
	</Script>|
	
	
End Sub
Function UnionSet(Set1 As Variant,Set2 As Variant) As Variant
	'此函数返回数组1和数组2的并集
	Dim ResultSet As Variant
	Dim newlist() As Variant
	Dim i As Integer
	Dim macro As String
	Dim ResultString As String
	
'如果数组1为空，返回数组2
	If Isempty(Set1) Then
		UnionSet=Set2
		Exit Function
	End If
	
'如果数组2为空，返回数组1
	If Set2(0)="" Then
		UnionSet=Set1
		Exit Function
	End If
	
	
	ResultSet=Arrayappend(set1,set2)
	ResultString=|"|+ResultSet(0)+|"|
	For i=1 To Ubound(ResultSet)
		ResultString=ResultString+|:"|+ResultSet(i)+|"|
	Next
	macro=|@unique(|+ResultString+|)|
	
	UnionSet=Evaluate(macro$)
End Function
Function  RebuildList(InputList As Variant,CompareValue As String) As Variant
	On Error Goto errhandler	
	
	Dim oldlist() As Variant
	Dim newlist() As Variant
'This routine removes a value from a list (passed by reference)
	
	Dim ListMax As Integer
	Dim i As Integer
	Dim x As Integer
	Dim y As Integer
	
	ListMax = Ubound(InputList)
	
'Save original capitalization in OldList then lowercase both InputList and CompareValue     
	Redim OldList (ListMax)
	For i = 0 To ListMax
		OldList(i) = InputList(i)
		InputList(i) = Lcase(InputList(i))
	Next
	CompareValue = Lcase(CompareValue)
	
	Redim NewList (ListMax)
	x = 0 
	For y = 0 To ListMax
		If InputList(y) <> CompareValue Then
			NewList(x) = OldList(y)
			x = x + 1
		End If
	Next
	
	If x > 0 Then
		Redim Preserve NewList(x-1)
	Else
		Redim NewList(0)
		NewList(0)=""
	End If
	
	RebuildList = NewList
	
	Exit Function
errhandler:
	ShowError("RebuildList")
End Function
Function GetDBPath(db As notesdatabase) As String
'『函数功能』
'	获取指定数据库相对于根的路径和文件名
'『函数接口』
'	db	input	数据库对象
'『函数返回值』
'	数据库文件路径字符串，例如：bbs/developers.nsf
'『备注』
'	该函数一般用于服务器端，当在本地运行时，返回如下形式：H:/hhwork/developers.nsf
	
	GetDBPath = replacestring(replacestring(db.filepath," ","+"),"\","/")
	
End Function
Function getindex(astrArray As Variant,strTarget As String) As Integer
'『函数功能』
'	在指定字符串数组中查找某个字符串，返回它在数组中的位置（数组下标）
'『函数接口』
'	astrArray		input	目标字符串数组
'	strTarget		input	查找的目标字符串
'『函数返回值』
'	类型：integer	目标字符串在数组中的位置（数组下标）
'	如果没有找到，返回 -1
'『作者』
	
'『修改历史』
	
'		整理代码，添加注释，规范函数命名，代码书写，使之符合规范
	
	If Isempty(astrArray) Then
		getindex = -1
		Exit Function
	End If
	
	Dim i As Variant
	getindex = -1
	For i=0 To Ubound(astrArray)
		If Trim(Lcase(astrArray(i)))=Trim(Lcase(strTarget)) Then
			getindex = i
			Exit Function
		End If
	Next i
	
End Function
Function appendNameAryToList(astrDes As Variant, astrSrc As Variant) As Variant
'把类型为name的数组追加到另一个数组后面
	
	On Error Goto errhandle
	Dim astr As Variant
	Dim strName As notesname
	Dim i As Integer
	Dim j As Integer
	Dim intFlag As Integer
	
	astr=astrDes
	For i=0 To Ubound(astrSrc)
		Set strName=New notesname(astrSrc(i))
		intFlag=0
		For j=0 To Ubound(astr)
			If strName.canonical=astr(j) Or strName.abbreviated=astr(j) Or strName.common=astr(j) Then
				intFlag=1
				j=Ubound(astr)+1
			End If
		Next j
		If intFlag=0 Then
			If Ubound(astr)=0 And Trim(astr(0))="" Then
				astr(0)=strName.canonical
			Else
				Redim Preserve astr(Ubound(astr)+1)
				astr(Ubound(astr))=strName.canonical
			End If
		End If
	Next i
	
	appendNameAryToList=astr
	Exit Function
errhandle:
	Msgbox "appendNameAryToList:" + Cstr(Error()) + " at line "+Cstr(Erl())
	appendNameAryToList=astr
End Function
Function getUserList(uname As Variant,doc As notesdocument) As Variant
'处理用户列表，其中可能有群组	
	
' 为3.0结构做修改
	
	On Error Goto errhandle
	
	Dim group As Variant
	Dim s As New notessession
	Dim userList,alluser As Variant
	Dim db As notesdatabase
	Dim vw As notesview
	Dim docGroup As notesdocument
	Dim key As String 
	Dim flg As Integer
	
	flg=0
	Dim i As Integer
	
	Redim alluser(0)
	alluser(0)=""
	
	'Set db = s.getdatabase("","stdPublic/indinames.nsf")
	Set db = s.getdatabase("","stdPublic/stdnames.nsf")
	Set vw = db.getview("vwGroupbyname")
	For i=0 To Ubound(uname)
		key = uname(i)
		Set docGroup = vw.getdocumentbykey(key,True)
		If docGroup Is Nothing Then
			Redim userList	(0)
			userList(0)=uname(i)
		Else
			userlist = docGroup.getItemvalue("members")
		End If
		alluser = appendAryToList(alluser, userlist)
	Next i
	
	getUserList=alluser
	Exit Function
errhandle:
	Msgbox "getUserList:" + Cstr(Error())+ " at line "+ Cstr(Erl())
End Function